home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / axis.for next >
Text File  |  1991-04-13  |  4KB  |  132 lines
  1.         SUBROUTINE AXIS(BLOW,BHIGH,MAXTKS,LSHORT,LRAGGD,BMIN,BMAX,
  2.      1   BTMIN,BTMAX,BTICK,IPWR)
  3.         IMPLICIT NONE
  4.         LOGICAL*1 LSHORT, LRAGGD
  5. C
  6. C       THIS SUBROUTINE IS MAINLY FOR INTERNAL USE,
  7. C       ITS FUNCTION IS TO DETERMINE A SUITABLE
  8. C       "TICK" DISTANCE OVER THE RANGE SPECIFIED BETWEEN
  9. C       ALOW AND AHIGH.   IT OUTPUTS THE AXIS RANGE BMIN,BMAX
  10. C       AND THE TICK DISTANCE BTICK STRIPPED OF THEIR POWER OF
  11. C       TEN.   THE POWER OF TEN IS RETURNED IN THE VAR. IPWR.
  12. C
  13.         INTEGER JTICKS(6),MINTKS,MAXTKS,I,NTICK,NINTVL
  14.         LOGICAL*2 LDIVDS
  15.         LOGICAL*1 LISNEG
  16.         REAL*4 TOOCLS,FUZZ,RANGE,TEMP,TENX,ASTRT,AFIN,TICK
  17. C
  18. C       IF A RAGGED AXIS IS "TOO CLOSE" TO THE NEXT TICK, THEN EXTEND IT.
  19. C        THE "TOO CLOSE" PARAMETER IS THE VARIABLE TOOCLS
  20. C
  21.         DATA TOOCLS /0.8/
  22. C
  23.         DATA FUZZ /0.001/
  24.         DATA JTICKS /1,2,5,4,3,10/
  25. C
  26. C
  27.         MAXTKS = MAX0(1,MAXTKS)
  28.         MINTKS = MAX0(1,MAXTKS/2)
  29.         BMAX = BHIGH
  30.         BMIN = BLOW
  31.         LISNEG = .FALSE.
  32.         IF (BMAX .GE. BMIN) GO TO 30
  33.         BMAX = BLOW
  34.         BMIN = BHIGH
  35.         LISNEG = .TRUE.
  36. C
  37. C       MAKE SURE WE HAVE ENOUGH RANGE, IF NOT, INCREASE AHIGH
  38. C
  39. 30      RANGE = BMAX - BMIN
  40.         TEMP = AMAX1(ABS(BMIN),ABS(BMAX))
  41.         IF (TEMP .EQ. 0.0) TEMP = 10.0
  42.         IF (RANGE/TEMP .GE. 5.0E-3) GO TO 40
  43.                 BMIN = BMIN - 5.0E-3*TEMP
  44.                 BMAX = BMAX + 5.0E-3*TEMP
  45. 40      CONTINUE
  46. C
  47. C       STRIP THE RANGE OF ITS POWER OF TEN
  48. C
  49.         IPWR=ALOG10(BMAX-BMIN)-2
  50. 50      TENX = 10.0**IPWR
  51.         ASTRT = AINT(BMIN/TENX)
  52.         AFIN = AINT(BMAX/TENX+0.999)
  53.         IF (AFIN*TENX .LT. BMAX) AFIN = AFIN + 1
  54.         RANGE = AFIN - ASTRT
  55.         IF (RANGE .LE. 10*MAXTKS) GO TO 75
  56.         IPWR = IPWR + 1
  57.         GO TO 50
  58. 75      CONTINUE
  59. C
  60. C       SEARCH FOR A SUITABLE TICK
  61. C
  62. D       TYPE 9999, BMIN, ASTRT, BMAX, AFIN, TENX
  63. D9999   FORMAT(/' AXIS DEBUG'/'      DATA          STRIPPED'/
  64. D       1   2(1X,G14.7,2X,G14.7/)/' POWER = ',G14.7)
  65.         BTICK = 0
  66.         DO 100 I=1,6
  67.         TICK = JTICKS(I)
  68.         NTICK = RANGE/TICK+0.999
  69.         IF (NTICK .LT. MINTKS .OR. NTICK .GT. MAXTKS) GO TO 100
  70.         IF (LDIVDS(ASTRT,TICK) .AND. LDIVDS(AFIN,TICK)) GO TO 150
  71.         IF (BTICK .EQ. 0) BTICK = TICK
  72. 100     CONTINUE
  73. C
  74. C       USE BEST NON-PERFECT TICK
  75. C
  76.         GO TO 160
  77. C
  78. C       FOUND A GOOD TICK
  79. C
  80. 150     BTICK=JTICKS(I)
  81. 160     CONTINUE
  82.         IF (BTICK .NE. 10.0) GO TO 165
  83.           BTICK = 1.0
  84.           IPWR = IPWR + 1
  85.           TENX = 10.0*TENX
  86. 165     TICK = BTICK*TENX
  87. C
  88. C       FIGURE OUT TICK LIMITS
  89. C
  90.         BTMIN = BTICK*AINT(BMIN/TICK)
  91.         IF (BTMIN*TENX .LT. BMIN) BTMIN = BTMIN + BTICK
  92.         BTMAX = BTICK*AINT(BMAX/TICK)
  93.         IF (BTMAX*TENX .GT. BMAX) BTMAX = BTMAX - BTICK
  94.         NINTVL = (BTMAX-BTMIN)/BTICK
  95. C
  96. C       IF USER ABSOLUTELY MUST HAVE RAGGED AXIS, THEN FORCE IT.
  97. C
  98.         IF (LSHORT .AND. LRAGGD) GO TO 180
  99. C
  100. C       CHECK INDIVIDUALLY
  101. C
  102.         IF (LSHORT .AND. (NINTVL .GT. 0) .AND.
  103.      1   ((BTMIN-BMIN/TENX)/BTICK .LE. TOOCLS) ) GO TO 170
  104.           IF ((BTMIN-BMIN/TENX) .GT. FUZZ) BTMIN = BTMIN - BTICK
  105.           BMIN = BTMIN*TENX
  106. 170     CONTINUE
  107.         IF (LSHORT .AND. (NINTVL .GT. 0) .AND.
  108.      1   ((BMAX/TENX-BTMAX)/BTICK .LE. TOOCLS) ) GO TO 180
  109.           IF ((BMAX/TENX-BTMAX) .GT. FUZZ) BTMAX = BTMAX + BTICK
  110.           BMAX = BTMAX*TENX
  111. 180     CONTINUE
  112.         IF (.NOT. LISNEG) GO TO 200
  113. C       SWITCH BACK TO BACKWARDS
  114.         BTICK = -BTICK
  115.         TEMP = BMIN
  116.         BMIN = BMAX
  117.         BMAX = TEMP
  118.         TEMP = BTMIN
  119.         BTMIN = BTMAX
  120.         BTMAX = TEMP
  121. 200     RETURN
  122.         END
  123.  
  124.         FUNCTION LDIVDS(ANUMER,ADENOM)
  125.         LOGICAL*2 LDIVDS
  126.         IF (ANUMER/ADENOM .EQ. AINT(ANUMER/ADENOM)) GO TO 10
  127.         LDIVDS = .FALSE.
  128.         RETURN
  129. 10      LDIVDS = .TRUE.
  130.         RETURN
  131.         END
  132.